home *** CD-ROM | disk | FTP | other *** search
/ Chip 1996 September / CHIP 1996 szeptember (CD07).zip / CHIP_CD07.ISO / sac / pack / vbdlh02.exe / VBDE_SRC.LZH / VBDEDIR.FRM < prev    next >
Text File  |  1996-03-08  |  13KB  |  393 lines
  1. VERSION 2.00
  2. Begin Form frmDirList 
  3.    BackColor       =   &H8000000F&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Directory"
  6.    ClientHeight    =   5385
  7.    ClientLeft      =   465
  8.    ClientTop       =   1770
  9.    ClientWidth     =   5550
  10.    Height          =   5760
  11.    Left            =   420
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   5385
  16.    ScaleWidth      =   5550
  17.    Top             =   1440
  18.    Width           =   5640
  19.    Begin CheckBox chkDir 
  20.       Caption         =   "Over&write"
  21.       Height          =   375
  22.       Index           =   1
  23.       Left            =   3240
  24.       TabIndex        =   8
  25.       Top             =   2520
  26.       Value           =   1  'Checked
  27.       Width           =   2055
  28.    End
  29.    Begin Frame fraDirList 
  30.       Caption         =   "&Type"
  31.       Height          =   1335
  32.       Left            =   3240
  33.       TabIndex        =   9
  34.       Top             =   3000
  35.       Width           =   2055
  36.       Begin OptionButton optFile 
  37.          Caption         =   "All Files"
  38.          Height          =   375
  39.          Index           =   1
  40.          Left            =   120
  41.          TabIndex        =   11
  42.          Top             =   840
  43.          Width           =   1335
  44.       End
  45.       Begin OptionButton optFile 
  46.          Caption         =   "Selected Files"
  47.          Height          =   375
  48.          Index           =   0
  49.          Left            =   120
  50.          TabIndex        =   10
  51.          Top             =   360
  52.          Value           =   -1  'True
  53.          Width           =   1335
  54.       End
  55.    End
  56.    Begin CheckBox chkDir 
  57.       Caption         =   "&Use Directories"
  58.       Height          =   375
  59.       Index           =   0
  60.       Left            =   3240
  61.       TabIndex        =   7
  62.       Top             =   2040
  63.       Value           =   1  'Checked
  64.       Width           =   2055
  65.    End
  66.    Begin CommandButton cmdDirList 
  67.       Caption         =   "&Make Dir..."
  68.       Height          =   495
  69.       Index           =   3
  70.       Left            =   3240
  71.       TabIndex        =   12
  72.       Top             =   4560
  73.       Width           =   2055
  74.    End
  75.    Begin CommandButton cmdDirList 
  76.       Caption         =   "&Help"
  77.       Height          =   495
  78.       Index           =   2
  79.       Left            =   3240
  80.       TabIndex        =   6
  81.       Top             =   1440
  82.       Width           =   2055
  83.    End
  84.    Begin CommandButton cmdDirList 
  85.       Cancel          =   -1  'True
  86.       Caption         =   "&Cancel"
  87.       Height          =   495
  88.       Index           =   1
  89.       Left            =   3240
  90.       TabIndex        =   5
  91.       Top             =   840
  92.       Width           =   2055
  93.    End
  94.    Begin CommandButton cmdDirList 
  95.       Caption         =   "&OK"
  96.       Default         =   -1  'True
  97.       Height          =   495
  98.       Index           =   0
  99.       Left            =   3240
  100.       TabIndex        =   4
  101.       Top             =   240
  102.       Width           =   2055
  103.    End
  104.    Begin DriveListBox drvUnpack 
  105.       Height          =   390
  106.       Left            =   240
  107.       TabIndex        =   3
  108.       Top             =   4680
  109.       Width           =   2775
  110.    End
  111.    Begin DirListBox dirUnpack 
  112.       Height          =   3330
  113.       Left            =   240
  114.       TabIndex        =   1
  115.       Top             =   960
  116.       Width           =   2775
  117.    End
  118.    Begin Label lblPath 
  119.       AutoSize        =   -1  'True
  120.       BackColor       =   &H8000000F&
  121.       BackStyle       =   0  'Transparent
  122.       Caption         =   "Path"
  123.       Height          =   270
  124.       Left            =   240
  125.       TabIndex        =   13
  126.       Top             =   600
  127.       Width           =   420
  128.    End
  129.    Begin Label lblDirlist 
  130.       AutoSize        =   -1  'True
  131.       BackColor       =   &H8000000F&
  132.       BackStyle       =   0  'Transparent
  133.       Caption         =   "Dri&ve:"
  134.       Height          =   195
  135.       Index           =   1
  136.       Left            =   240
  137.       TabIndex        =   2
  138.       Top             =   4320
  139.       Width           =   525
  140.    End
  141.    Begin Label lblDirlist 
  142.       AutoSize        =   -1  'True
  143.       BackColor       =   &H8000000F&
  144.       BackStyle       =   0  'Transparent
  145.       Caption         =   "&Directory:"
  146.       Height          =   195
  147.       Index           =   0
  148.       Left            =   240
  149.       TabIndex        =   0
  150.       Top             =   240
  151.       Width           =   840
  152.    End
  153. End
  154. '===================================================
  155. 'Sample VB program using UNLHA.DLL
  156. 'VBDeDir.Frm    (frmDirList)
  157. 'Original: Niiyama(HEROPA) SGV00153@niftyserve.or.jp
  158. 'English : Hitoshi Ozawa   h_ozawa@bekkoame.or.jp
  159. '===================================================
  160. Option Explicit
  161.     Dim mstrUnpackDir As String
  162.     Const BTN_OK = 0
  163.     Const BTN_CANCEL = 1
  164.     Const BTN_HELP = 2
  165.     Const BTN_MKDIR = 3
  166.  
  167. Sub cmdDirList_Click (Index As Integer)
  168.     Dim intReturnCode As Integer    'WinHelp return codel
  169.     Select Case Index
  170.     Case BTN_OK
  171.     If Right$(mstrUnpackDir$, 1) <> "\" Then mstrUnpackDir$ = mstrUnpackDir$ & "\"
  172.     gstrUnpackDir$ = mstrUnpackDir$
  173.     gintfUnpackCancel% = False
  174.     gintbDirFlag% = CInt(chkDir(0).Value) * (-1)
  175.     gintbOverWriteFalg% = CInt(chkDir(1).Value) * (-1)
  176.     Me.Hide
  177.     Case BTN_CANCEL
  178.     gstrUnpackDir$ = ""
  179.     gintfUnpackCancel% = True
  180.     Unload Me
  181.     Case BTN_HELP
  182.     intReturnCode% = WinHelp(frmArchive.hWnd, gstrHelpFile$, HELP_CONTEXT, ByVal HLP_DLGCHOOSEDIR&)
  183.     Case BTN_MKDIR
  184.     Call MakeDir
  185.     End Select
  186. End Sub
  187.  
  188. Sub dirUnpack_Change ()
  189.     mstrUnpackDir$ = dirUnpack.Path
  190.     If Me.TextWidth(mstrUnpackDir$) >= dirUnpack.Width Then
  191.     lblPath.Caption = GetShortName(mstrUnpackDir$)
  192.     Else
  193.     lblPath.Caption = mstrUnpackDir$
  194.     End If
  195. End Sub
  196.  
  197. Sub drvUnpack_Change ()
  198.     Dim strErrMsg       As String
  199.     Dim intType         As Integer
  200.     Dim intReturnCode   As Integer
  201.     On Error GoTo ErrDriveChange:
  202.  
  203.     dirUnpack.Path = drvUnpack.Drive
  204.  
  205.     Exit Sub
  206. ErrDriveChange:
  207.     Select Case Err
  208.     Case 68 'Device not ready
  209.     strErrMsg$ = "Drive" & drvUnpack.Drive & " is not ready."
  210.     intType% = MB_RETRYCANCEL Or MB_ICONEXCLAMATION
  211.     intReturnCode% = MsgBox(strErrMsg$, intType%, APP_CAPTION)
  212.     If intReturnCode% = IDRETRY Then
  213.         Resume
  214.     End If
  215.     Case Else
  216.     MsgBox "Unpredicted error. Err:" & Err
  217.     End Select
  218.     'Return drive
  219.     drvUnpack.Drive = dirUnpack.Path
  220.     Resume Next
  221. End Sub
  222.  
  223. Sub Form_Load ()
  224.     Dim intLoopCount As Integer
  225.     Dim intbSelectFlag As Integer
  226.     Call SetControlPosition
  227.     Call SetControl3D
  228.     'Check if List box was selected
  229.     intbSelectFlag% = False
  230.     For intLoopCount% = 0 To frmArchive!lstArchive.ListCount - 1
  231.     If frmArchive!lstArchive.Selected(intLoopCount%) = True Then
  232.         intbSelectFlag% = True
  233.     End If
  234.     Next intLoopCount%
  235.     'if selected
  236.     If intbSelectFlag% = True Then
  237.     optFile(0).Value = True
  238.     optFile(1).Value = False
  239.     'if not selected
  240.     Else
  241.     optFile(1).Value = True
  242.     optFile(0).Value = False
  243.     optFile(1).Enabled = False
  244.     optFile(0).Enabled = False
  245.     fraDirList.Enabled = False
  246.     End If
  247.     'Recurse Directory option
  248.     If gintbDirFlag% = True Then
  249.     chkDir(0).Value = CHECKED
  250.     Else
  251.     chkDir(0).Value = UNCHECKED
  252.     End If
  253.     'Overwrite option
  254.     If gintbOverWriteFalg% = True Then
  255.     chkDir(1).Value = CHECKED
  256.     Else
  257.     chkDir(1).Value = UNCHECKED
  258.     End If
  259.     mstrUnpackDir$ = LCase$(gstrUnpackDir$)
  260.     dirUnpack.Path = mstrUnpackDir$
  261.     drvUnpack.Drive = mstrUnpackDir$
  262.     If Me.TextWidth(mstrUnpackDir$) >= dirUnpack.Width Then
  263.     lblPath.Caption = GetShortName(mstrUnpackDir$)
  264.     Else
  265.     lblPath.Caption = mstrUnpackDir$
  266.     End If
  267.     Call SetChildWindowPos(frmArchive, Me)
  268.     Call DeleteSwitchTo(Me)
  269.     Me.Icon = frmArchive.Icon
  270.     Me.Caption = APP_CAPTION & " - " & Me.Caption
  271.     'If help file does not exist
  272.     If gstrHelpFile$ = "" Then cmdDirList(BTN_HELP).Enabled = False
  273. End Sub
  274.  
  275. 'display InputBox and create directory based on input
  276. Sub MakeDir ()
  277.     Dim strReturnStrings    As String   'InputBox return code
  278.     Dim strMsg              As String   'MsgBox
  279.     Dim intType             As Integer  'MsgBox
  280.     Dim strMakePath         As String   'make directory
  281.  
  282.     strMsg$ = "Please enter directory name below " & dirUnpack.Path & "."
  283.     strReturnStrings$ = Trim(InputBox(strMsg$, "Make Dir"))
  284.     If strReturnStrings$ = "" Then Exit Sub
  285.     On Error GoTo ErrInput
  286.     strMakePath$ = dirUnpack.Path
  287.     If Right$(strMakePath$, 1) <> "\" Then strMakePath$ = strMakePath$ & "\"
  288.     MkDir strMakePath$ & strReturnStrings$
  289.     dirUnpack.Path = strMakePath$ & strReturnStrings$
  290. Exit Sub
  291. ErrInput:
  292.     Select Case Err
  293.     Case 75 'directory already exists
  294.     strMsg$ = strReturnStrings$ & " already exists. Extract files there?"
  295.     intType% = MB_YESNO Or MB_ICONQUESTION
  296.     If MsgBox(strMsg$, intType%, APP_CAPTION) = IDYES Then
  297.         Resume Next
  298.     End If
  299.     Case Else
  300.     strMsg$ = "Failed to make directory " & strReturnStrings$ & ". MakeDirErr: " & Err
  301.     MsgBox strMsg, MB_ICONEXCLAMATION, APP_CAPTION
  302.     Exit Sub
  303.     End Select
  304. Resume
  305. End Sub
  306.  
  307. 'draw 3D objects about controls
  308. Sub SetControl3D ()
  309.     Me.AutoRedraw = True
  310.     Call Draw3DControl(dirUnpack)
  311.     Call Draw3DControl(drvUnpack)
  312.     Call Draw3DForm(Me)
  313.     Me.AutoRedraw = False
  314. End Sub
  315.  
  316. 'set control position
  317. Sub SetControlPosition ()
  318.     Const DLG_SPACE = 4
  319.     
  320.     dirUnpack.Width = Me.TextWidth(String$(15, "A"))
  321.     lblDirList(0).Left = 2 * DLG_SPACE * Screen.TwipsPerPixelX
  322.     lblDirList(0).Top = 2 * DLG_SPACE * Screen.TwipsPerPixelY
  323.     
  324.     lblPath.Left = lblDirList(0).Left
  325.     lblPath.Top = lblDirList(0).Top + lblDirList(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  326.     
  327.     cmdDirList(0).Left = dirUnpack.Left + dirUnpack.Width + 2 * DLG_SPACE * Screen.TwipsPerPixelX
  328.     cmdDirList(0).Top = lblDirList(0).Top
  329.     cmdDirList(0).Width = Me.TextWidth("Dirì∞ɼ(M)...") + 3 * DLG_SPACE * Screen.TwipsPerPixelX
  330.     cmdDirList(0).Height = Me.TextHeight("OK") + 3 * DLG_SPACE * Screen.TwipsPerPixelY
  331.     
  332.     cmdDirList(1).Left = cmdDirList(0).Left
  333.     cmdDirList(1).Top = cmdDirList(0).Top + cmdDirList(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  334.     cmdDirList(1).Width = cmdDirList(0).Width
  335.     cmdDirList(1).Height = cmdDirList(0).Height
  336.  
  337.     cmdDirList(2).Left = cmdDirList(1).Left
  338.     cmdDirList(2).Top = cmdDirList(1).Top + cmdDirList(1).Height + DLG_SPACE * Screen.TwipsPerPixelY
  339.     cmdDirList(2).Width = cmdDirList(1).Width
  340.     cmdDirList(2).Height = cmdDirList(1).Height
  341.  
  342.     chkDir(0).Left = cmdDirList(2).Left
  343.     chkDir(0).Top = cmdDirList(2).Top + cmdDirList(2).Height + DLG_SPACE * Screen.TwipsPerPixelY
  344.     chkDir(0).Width = cmdDirList(2).Width
  345.     chkDir(0).Height = Me.TextHeight("DirùLî°") + DLG_SPACE * Screen.TwipsPerPixelY
  346.     chkDir(0).BackColor = Me.BackColor
  347.  
  348.     chkDir(1).Left = chkDir(0).Left
  349.     chkDir(1).Top = chkDir(0).Top + chkDir(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  350.     chkDir(1).Width = chkDir(0).Width
  351.     chkDir(1).Height = chkDir(0).Height
  352.     chkDir(1).BackColor = Me.BackColor
  353.  
  354.     fraDirList.Left = chkDir(1).Left
  355.     fraDirList.Top = chkDir(1).Top + chkDir(1).Height + DLG_SPACE * Screen.TwipsPerPixelY
  356.     fraDirList.Width = chkDir(1).Width
  357.     fraDirList.Height = 4 * Me.TextHeight("æ╬Å█") + 3 * DLG_SPACE * Screen.TwipsPerPixelY
  358.     fraDirList.BackColor = Me.BackColor
  359.  
  360.     optFile(0).Left = 2 * DLG_SPACE * Screen.TwipsPerPixelX
  361.     optFile(0).Top = Me.TextHeight("æ╬Å█") + 2 * DLG_SPACE * Screen.TwipsPerPixelY
  362.     optFile(0).Width = fraDirList.Width - 4 * DLG_SPACE * Screen.TwipsPerPixelX
  363.     optFile(0).Height = Me.TextHeight("æ╬Å█") + DLG_SPACE * Screen.TwipsPerPixelY
  364.     optFile(0).BackColor = Me.BackColor
  365.       
  366.     optFile(1).Left = optFile(0).Left
  367.     optFile(1).Top = optFile(0).Top + optFile(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  368.     optFile(1).Width = optFile(0).Width
  369.     optFile(1).Height = optFile(0).Height
  370.     optFile(1).BackColor = Me.BackColor
  371.  
  372.     cmdDirList(3).Left = fraDirList.Left
  373.     cmdDirList(3).Top = fraDirList.Top + fraDirList.Height + DLG_SPACE * Screen.TwipsPerPixelY
  374.     cmdDirList(3).Width = cmdDirList(2).Width
  375.     cmdDirList(3).Height = cmdDirList(2).Height
  376.  
  377.     drvUnpack.Left = lblDirList(0).Left
  378.     drvUnpack.Top = cmdDirList(3).Top + cmdDirList(3).Height - drvUnpack.Height
  379.     drvUnpack.Width = dirUnpack.Width
  380.  
  381.     lblDirList(1).Left = drvUnpack.Left
  382.     lblDirList(1).Top = drvUnpack.Top - lblDirList(1).Height - DLG_SPACE * Screen.TwipsPerPixelY
  383.  
  384.     dirUnpack.Left = lblDirList(0).Left
  385.     dirUnpack.Top = lblPath.Top + lblPath.Height + DLG_SPACE * Screen.TwipsPerPixelY
  386.     dirUnpack.Height = lblDirList(1).Top - dirUnpack.Top - DLG_SPACE * Screen.TwipsPerPixelY
  387.  
  388.     Me.Width = cmdDirList(3).Left + cmdDirList(3).Width + (2 * DLG_SPACE + 2 * gintCXDLGFRAME + 2) * Screen.TwipsPerPixelX
  389.     Me.Height = cmdDirList(3).Top + cmdDirList(3).Height + (2 * DLG_SPACE + 2 * gintCYDLGFRAME + gintCYCAPTION + 2) * Screen.TwipsPerPixelY
  390.  
  391. End Sub
  392.  
  393.